home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / modula2 / module / windowme.mod < prev    next >
Encoding:
Modula Implementation  |  1995-11-25  |  4.5 KB  |  131 lines
  1. IMPLEMENTATION MODULE  WindowMenue;
  2.  
  3. FROM SYSTEM IMPORT ADDRESS,VAL,TSIZE;
  4.  
  5. FROM EasyWindow IMPORT windowlist,windowtype,SetInfo;
  6.  
  7. FROM GEMAESbase IMPORT WorkXYWH, GraphicTitle,HideTree,None,Object;
  8.  
  9. FROM AES IMPORT MenuBar,WindowGet;
  10.  
  11. FROM Strings IMPORT Concat;
  12.  
  13. PROCEDURE GetObjectPointer(Index :INTEGER;  TreePtr:ADDRESS) : ADDRESS;
  14. BEGIN
  15.     RETURN TreePtr+VAL(ADDRESS, (Index*TSIZE(Object)));
  16. END GetObjectPointer;
  17.  
  18.  
  19.  
  20. PROCEDURE InstallMenu(WindowHandle : INTEGER; MenuTree:ADDRESS):BOOLEAN;
  21.  
  22. TYPE String = ARRAY [0..80] OF CHAR;
  23. VAR
  24.    win : windowtype;
  25.    x,y,w,h : INTEGER;
  26.    cx,cy,cw,ch : INTEGER;  (* Koordinaten Gesammtfenster *)
  27.    wx,wy,ww,wh : INTEGER;  (* Koordinaten Arbeitsbereich *)
  28.    dx,dy,dw,dh : INTEGER;  (* Bildschirmausmaße          *)
  29.    Index1,Index2 : INTEGER;(* Menü Indices               *)
  30.    MenuWidth : INTEGER;    (* Menübreite                 *)
  31.    tail,tail2,
  32.    head,head2,
  33.    temp1,temp2 : INTEGER;  (* div Abkürzungen            *)
  34.    tailptr,tail2ptr,
  35.    headptr,head2ptr,
  36.    rootptr,
  37.    index1ptr,index2ptr : POINTER TO Object;
  38.    buf : ADDRESS;
  39.    sp : POINTER TO String;
  40.    t : String;
  41.    OK :BOOLEAN;
  42.  
  43.  
  44. BEGIN
  45.   t[0]:=' ';t[1]:=3C;t[2]:=0C;
  46.   rootptr:=GetObjectPointer(0,MenuTree);
  47.   tail:=rootptr^.tail;
  48.   tailptr:=GetObjectPointer(tail,MenuTree);
  49.   tail2:=tailptr^.head;
  50.   head:=rootptr^.head;
  51.   headptr:=GetObjectPointer(head,MenuTree);
  52.   head2:=headptr^.head;
  53.   head2ptr:=GetObjectPointer(head2,MenuTree);
  54.   (* Ist das Fenster vorhanden,oben,offen ? *)
  55.   IF  windowlist[WindowHandle] # NIL THEN
  56.    IF  windowlist[WindowHandle]^.opened AND windowlist[WindowHandle]^.ontop THEN
  57.       win:=windowlist[WindowHandle]^;
  58.       windowlist[WindowHandle]^.reference:=MenuTree;
  59.       (* Größe des Fensters ermitteln *)
  60.  
  61.       cx:=win.total.x; cy:=win.total.y;
  62.       cw:=win.total.w; ch:=win.total.h;
  63.  
  64.       wx:=win.work.x; wy:=win.work.y;
  65.       ww:=win.work.w; wh:=win.work.h;
  66.  
  67.       x:=cx;y:=cy;h:=ch;w:=cw;
  68.       (* neue Position der Menüzeile *)
  69.       rootptr^.x:=cx+1;
  70.       MenuX:=cx;
  71.       rootptr^.y:=cy+((wy-cy)DIV 2);(* für Fenster mit Infozeile sonst nur y+ch-cw*)
  72.       MenuY:=cy+((wy-cy)DIV 2);
  73.       MenuH:=(wy-cy)DIV 2;
  74.       (* geht die Menüzeile über den Fensterrand hinaus ? *)
  75.       WindowGet(0,WorkXYWH,dx,dy,dw,dh);
  76.       IF (x+1 (*+w-cw*) +ww>dx+dw) THEN
  77.          w:=dw+dx-(x+1)+cw-ww-1;
  78.       END(*IF*);
  79.       (* Breite der Menüzeile = Breite des Fensters bzw Bildschirms *)
  80.       headptr^.width:=w-cw+ww;
  81.       Index1:=head2ptr^.head;
  82.       index1ptr:=GetObjectPointer(Index1,MenuTree);
  83.       Index2:= tail2;
  84.       index2ptr:=GetObjectPointer(Index2,MenuTree);
  85.       head2ptr^.width:=0;
  86.  
  87.       WHILE   index1ptr^.type=GraphicTitle DO
  88.             (* Breite des Menü-Titels *)
  89.             temp1:=rootptr^.x+headptr^.x+head2ptr^.x+index1ptr^.x+index1ptr^.width;
  90.             (* Breite des Menüeintrages *)
  91.             temp2:=rootptr^.x+tailptr^.x+index2ptr^.x+index2ptr^.width;
  92.             (* welche Menüs passen noch auf den Bildschirm bzw. ins Fenster *)
  93.             IF ((temp1>=dx+dw) OR (temp2>=dx+dw) OR
  94.                (temp1>=x+w-cw+ww) OR (temp2>=x+w-cw+ww)) THEN
  95.                (* alle nicht mehr auf den Bildschirm passenden Menüs abschalten *)
  96.                WHILE index1ptr^.type=GraphicTitle DO
  97.                     index1ptr^.flags:=HideTree;
  98.                     Index1:=index1ptr^.next;
  99.                     index1ptr:=GetObjectPointer(Index1,MenuTree);
  100.                END(*WHILE*);
  101.              ELSE
  102.                (* Breite der Menüzeile anpassen *)
  103.                head2ptr^.width:=index1ptr^.x+index1ptr^.width;
  104.                MenuW:=head2ptr^.width;
  105.                (* Menü eingeshaltet *)
  106.                index1ptr^.flags:=None;
  107.                (* Menüeintrage als Info setzen *)
  108.                sp:=index1ptr^.spec;
  109.                Concat(t,sp^,t,OK);
  110.                Index1:=index1ptr^.next;
  111.                Index2:=index2ptr^.next;
  112.                index1ptr:=GetObjectPointer(Index1,MenuTree);
  113.                index2ptr:=GetObjectPointer(Index2,MenuTree);
  114.              END(*IF*);
  115.       END(*WHILE*);
  116.       (* Menüzeile zeichnen *)
  117.       MenuBar(MenuTree,1);
  118.       SetInfo(WindowHandle,t);
  119.     RETURN TRUE
  120.     END(*IF*); (* falls das Fenster nicht offen bzw oberstes Fenster war *)
  121.   END(*IF*); (* falls kein Fenster mit handle = WindowHandle da ist *)
  122.   RETURN FALSE
  123. END InstallMenu;
  124.  
  125. BEGIN
  126.    MenuX:=0;
  127.    MenuY:=0;
  128.    MenuW:=0;
  129.    MenuH:=0;
  130. END WindowMenue.
  131.